home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / door / twview93.zip / DISTANCE.INC < prev    next >
Text File  |  1992-03-11  |  3KB  |  104 lines
  1. procedure TwoWayDistances( sec : sector; var D : distanceArray;
  2.                            inward, outward : boolean );
  3. { inward = accept TOWARD sec; outward = accept LEAVING sec }
  4. { D[j].d = distance from sec;
  5.   D[j].s = one node close }
  6. var
  7.   si : sectorIndex;
  8.   wi : warpIndex;
  9.   breadth : queue;
  10.   s,
  11.   daddy, sonny : sector;
  12.   i : warpindex;
  13.   entered : array [ sector ] of boolean;
  14. begin
  15.   if inward then
  16.     write('(This may take a while.)  ');
  17.   writeln('Computing distances...');
  18.   for s := 1 to maxSector do
  19.     begin
  20.       D[s].d := -1;
  21.       entered[ s ] := false;
  22.     end; {for}
  23.   breadth.front := 0;
  24.   enqueue( breadth, sec, sec );
  25.   entered[sec] := true;
  26.   while breadth.front > 0 do
  27.     begin
  28.       serve( breadth, daddy, sonny );
  29.       if D[ sonny ].d = -1 then {haven't hit him before:}
  30.         begin
  31.           D[ sonny ].d := D[ daddy ].d + 1;
  32.           D[ sonny ].s := daddy;
  33.           if outward then
  34.             with space.sectors[ sonny ] do if number > 0 then
  35.               if (space.sectors[sonny].etc and avoid) = Nothing then
  36.                 for wi := 1 to number do
  37.                   if not entered[ data[wi] ] then
  38.                     begin
  39.                       enqueue( breadth, sonny, data[ wi ] );
  40.                       entered[ data[wi] ] := true;
  41.                     end; {if with for if}
  42.           if inward then
  43.             for s := 1 to maxSector do
  44.               if not entered[ s ] then
  45.                 if IsWarp( s, sonny ) then
  46.                   begin
  47.                     enqueue( breadth, sonny, s );
  48.                     entered[ s ] := true;
  49.                   end; {if for if if}
  50.         end; {if}
  51.     end; {while}
  52.   for s := 1 to maxSector do if D[s].d = -1 then D[s].d := maxint;
  53. end; {FixDistances}
  54.  
  55. function CountDist(var D : distancearray; howfar : integer ):integer;
  56. var
  57.   c : integer;
  58.   s : sector;
  59. begin
  60.   c := 0;
  61.   for s := 1 to maxSector do
  62.     if D[ s ].d <= howfar then
  63.       c := c + 1;
  64.   countDist := c;
  65. end; {CountDist}
  66.  
  67. procedure SortDistances( var D : distancearray; largest : sector );
  68. { sort, based upon "d" field.  }
  69. var
  70.   smallest : dist;
  71.   where    : sector;
  72.   s, t     : sector;
  73. begin
  74.   for s := 1 to largest - 1 do
  75.     begin
  76.       smallest := d[s];
  77.       where := s;
  78.       for t := s + 1 to largest do
  79.         if smallest.d > d[t].d then
  80.           begin
  81.             smallest := d[t];
  82.             where := t;
  83.           end; {for t}
  84.         d[where] := d[s];
  85.         d[s] := smallest;
  86.     end; {for s}
  87. end; {Sort Distances}
  88.  
  89. function SetupDistances : boolean;
  90. { return false if they aborted }
  91. var
  92.   s, n : integer;
  93. begin
  94.   s := GetSector;
  95.   if s <> 0 then
  96.     begin
  97.       TwoWayDistances( s, distances, false, true );
  98.       for n := 1 to maxSector do distances[ n ].s := n;
  99.       SetUpDistances := true;
  100.     end {if}
  101.   else
  102.     SetUpDistances := false;
  103. end; {SetUpDistances}
  104.